perm filename CPYIT.FAI[XX,LCS] blob sn#206580 filedate 1976-03-15 generic text, type T, neo UTF8
00100	;***** COPYIT
00200		TITLE COPYIT
00300		INTERNAL COPYIT,UPDN,STFCH,NOIR,SLEND,POSIT
00400		EXTERNAL .COMM.,POSI,XRN,PTR,SCM,AMOD
00500		EXTERNAL OUTLIM,RTLINE,LOOP
00600	;;	DEFINE FLOAT(N)
00700	;; <	TLC N,232000
00800	;;	FADR N,N   >
00900		DEFINE FIXX(N)
01000	<	JUMPGE	N,.+5
01100		MOVNS	N
01200		FIX 	N,233000    
01300		MOVNS	N
01400		CAIA
01500		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01600	
01700	;	SUBROUTINE COPYIT
01800	;	COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
01900	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
02000	;	1/PTR/PWDS(250),ITEM,LL,I,IX
02100	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
02200	;	1,(R6,RJQ(4)),(N,RN(2500))
02300	STFCH:	0
02400		SETO 13,	;FLAG FOR STFCH ROUTINE
02500		JRST .+3
02600	
02700	COPYIT:	0
02800		SETZ 13,	;MAKE SURE IT'S 0
02900		SETZ 7,		;IM=ITEM
03000		MOVE 15,PTR+=250 	; AC7 IS K-1
03100		SOJ 15,		;(ITEM-1)
03200	CP1:	JSA 16,RTLINE	;DO 1 K=1,IM
03300		JUMP PTR(7)	;L=PWDS(K)
03400		JUMPL CPY	;	IF(RTLINE(L))GO TO 1
03500		JSA 16,OUTLIM	;IF(OUTLIM(L,3))GO TO 1
03600		JUMP PTR(7)
03700		JUMP [3]
03800		JUMPL CPY
03900		MOVE 11,PTR(7)	; NOW L IS AC11
04000		MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
04100		JUMPE 10,CP3
04200		CAMN 10,XRN(11)
04300		JRST CPY
04400	CP3:	JUMPL 13,STF2	; SKIP OVER FOR STFCH ROUTINE
04500		MOVE 12,XRN-1(11)
04600		FIXX(12)	;M=RN(L)+2
04700		ADDI 12,2
04800		JSA 16,LOOP	;CALL LOOP(0,M,1,I,L,RN)
04900		JUMP [0]
05000		JUMP 12
05100		JUMP [1]
05200		JUMP PTR+=252
05300		JUMP 11
05400		JUMP XRN
05500		AOS PTR+=250	;ITEM=ITEM+1
05600		MOVE 13,PTR+=250
05700		MOVE 11,PTR-1(13)	;L=PWDS(ITEM)
05800	STF2:	MOVE 14,.COMM.+=8	;RN(L+2)=R7
05900		MOVEM 14,XRN+1(11)
06000		JUMPGE 13,CP2
06100		SKIPL POSI+=8	;THIS FOR STFCH
06200		JRST CPY	; IF(JJ2)JJ2=K
06300		MOVE 14,7
06400		AOJ 14,
06500		MOVEM 14,POSI+=8
06600		JRST CPY
06700	CP2:	SKIPGE POSI+=8	;IF(JJ2)JJ2=ITEM
06800		MOVEM 13,POSI+=8
06900		AOJ 12,	;I=I+M+1
07000		ADD 12,PTR+=252
07100		MOVEM 12,PTR+=252
07200		MOVEM 12,PTR(13)	;PWDS(ITEM+1)=I
07300	CPY:	CAMGE 7,15	;1 CONTINUE
07400		AOJA 7,CP1
07500	;;	JRST CP1
07600		JUMPL 13,.+3
07700		MOVE 7,.COMM.+=8	;R2=R7
07800		MOVEM 7,.COMM.		;DOES THIS MATTER FOR STFCH⎇
07900		JRA 16,(16)	;END
08000	
08100		;SUBROUTINE STFCH
08200		;INTEGER PWDS
08300		;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
08400		;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
08500		;1/PTR/PWDS(250),ITEM,LL,I,IX
08600		;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
08700		;DO 1 K=1,ITEM
08800		;L=PWDS(K)
08900		;IF(RTLINE(L))GO TO 1
09000		;IF(OUTLIM(L,3))GO TO 1
09100		;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
09200	;C DIDN'T MATCH THE CODE NUM.
09300		;IF(JJ2)JJ2=K
09400		;RN(L+2)=R7
09500	;1	CONTINUE
09600		;END
09700	
09800	UPDN: 	0	;SUBROUTINE UPDN(NST)
09900		;INTEGER PWDS
10000		;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
10100		;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
10200		;1/PTR/PWDS(250),ITEM,LL,I,IX
10300	        MOVE 7,@(16)	;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
10400	    			;1,(R6,RJQ(4))
10500	UPDN0:	JSA 16,RTLINE	;DO 1 K=NST,ITEM
10600		JUMP PTR(7)	;L=PWDS(K)
10700		JUMPL UPDN1	;	IF(RTLINE(L))GO TO 1
10800		MOVE 11,PTR(7)	;RY=RN(L+1) -- 11 IS L
10900		MOVE 12,XRN(11)	;IF(RY.GT.16)GO TO 1
11000		CAMG 12,[16.0]	; AC12=RY
11100		CAME 12,[8.0]		;IF(RY.EQ.8)GO TO 1
11200		CAMN 12,[3.0]		;IF(RY.EQ.3)GO TO 1
11300		JRST UPDN1
11400		CAMN 12,.COMM.+7	;IF(RY.EQ.R6)GO TO 10
11500		JRST UPDN10
11600		SKIPE .COMM.+7		;IF(R6.NE.0)GO TO 1
11700		JRST UPDN1
11800	UPDN10:	CAME 12,[4.0]	; DIDN'T MATCH THE CODE NUM.
11900		JRST UPDN11	;10	;IF(RY.NE.4)GO TO 11
12000		MOVE 2,XRN-1(11)	;IF(RN(L).LT.3)GO TO 1
12100		CAMGE 2,[3.0]
12200		JRST UPDN1	; A BAR LINE
12300	UPDN11:	JSA 16,OUTLIM	;11	IF(OUTLIM(L,3))GO TO 2
12400		JUMP PTR(7)
12500		JUMP [3]
12600		JUMPL UPDN2
12700		MOVE 2,.COMM.+=12	;RN(L+4)=RN(L+4)+R11
12800		FADRM 2,XRN+3(11)
12900		SKIPL POSI+=8		;IF(JJ2)JJ2=K
13000		JRST UPDN2
13100		MOVE 2,7
13200		AOJ 2,
13300		MOVEM 2,POSI+=8
13400	UPDN2:	CAML 12,[4.0]	;2	;IF(RY.LT.4)GO TO 1
13500		CAML 12,[7.0]	;IF(RY.GE.7)GO TO 1
13600		JRST UPDN1	; NO WIGGLE ON TRILL
13700		CAME 12,[4.0]	;IF(RY.NE.4.)GO TO 12
13800		JRST UPDN12
13900		MOVE 15,XRN+4(11)	;IF(RN(L+5).EQ.50)GO TO 1
14000		CAMN 15,[50.0]		; 15 IS RN(L+5)
14100		JRST UPDN1	; CRESC. OR BOX
14200	UPDN12:	JSA 16,OUTLIM	;12	;IF(OUTLIM(L,6))GO TO 1
14300		JUMP PTR(7)
14400		JUMP [6]
14500		JUMPL UPDN1
14600		MOVE 3,.COMM.+=12	;RN(L+5)=RN(L+5)+R11
14700		FADRM 3,XRN+4(11)
14800		SKIPL POSI+=8		;IF(JJ2)JJ2=K
14900		JRST UPDN1
15000		MOVE 2,7
15100		AOJ 2,
15200		MOVEM 2,POSI+=8
15300	UPDN1:	CAMGE 7,PTR+=250	;1	;CONTINUE
15400		AOJA 7,UPDN0
15500		JRA 16,1(16)	;END
15600	
15700	NOIR:	0
15800		JRA 16,1(16)	; DUMMY ******
15900	
16000	SLEND:	0	;	SUBROUTINE SLEND
16100		MOVE 8,[8.0]	;INTEGER PWDS
16200		MOVE 7,SCM+=80	;C  TO FIND END POINTS OF STAVES
16300		MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
16400	;	1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
16500	; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
16600		SETZ 5,		;DO 1 K=1,ITEM
16700	SLN1:	MOVE 6,PTR(5)	;L=PWDS(K)
16800				;IF(RN(L+1).NE.8)GO TO 1
16900		CAME 8,XRN(6)	;C  FOUND A STAFF
17000		JRST SLN1X	;IF(RN(L+2).NE.STAFF)GO TO 1
17100		CAME 7,XRN+1(6)	;C GOT THE RIGHT ONE
17200		JRST SLN1X	;IF(IT)GO TO 2
17300		SKIPGE XRN+=2000	;POS=202
17400		JRST SLN2	;C NOW CHECK LEFT SIDE OF STAFF
17500		MOVE 15,[202.0]		;IF(RN(L).LT.4)RETURN
17600		CAML 4,XRN-1(6)	;P6 WASN'T MENTIONED - SO IT =200
17700		JRST SLN3
17800				;POS=RN(L+6)+2
17900		MOVE 15,XRN+5(6)	;IF(POS.EQ.2)POS=202
18000		FADR 15,[2.0]	;RETURN
18100		CAMN 15,[2.0]	;2 	POS=RN(L+3)-2.3
18200		MOVE 15,[202.0]		;RETURN
18300		JRST SLN3	;1	CONTINUE
18400	SLN2:	MOVE 15,XRN+2(6)	;END
18500		FSBR 15,[2.3]
18600	SLN3:	MOVEM 15,XRN+=2001
18700		JRA 16,(16)
18800	SLN1X:	AOS 5
18900		CAMGE 5,PTR+=250
19000		JRST SLN1
19100		JRA 16,(16)
19200	
19300	POSIT:	0	;	FUNCTION POSIT(V)
19400		MOVE 15,@(16)	;	COMMON/XRN/RN(4000)
19500		SKIPGE 15	;	DIMENSION POSNT(0/82)
19600		MOVNS 15	;	EQUIVALENCE (POSNT,RN(3801))
19700		MOVE 14,15	;	1,(A,RN(3884)),(K,RN(3885))
19800		FIXX(14)	;	IF(V)V=-V
19900	;  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
20000		JSA 16,AMOD	;	K=V
20100		JUMP 15		;	A=POSNT(K)
20200		JUMP [1.0]	;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
20300	; TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
20400		MOVE 2,XRN+=3801(14)	;	END
20500		FSBR 2,XRN+=3800(14)
20600		FMPR 0,2
20700		FADR 0,XRN+=3800(14)
20800		JRA 16,1(16)
20900		END